home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / net-polly.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  3KB  |  112 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defmodule net-polly
  8.  
  9.   (lists
  10.    list-operators
  11.    extras
  12.    streams
  13.    others
  14.    formatted-io
  15.    sockets
  16.    arith
  17.    vectors
  18.    tables
  19.    ccc) ()
  20.  
  21.   (deflocal local-display (getenv "DISPLAY"))
  22.  
  23.   (deflocal x-vert 5)
  24.   
  25.   (defun run-remote-string (exp host)
  26.     (format nil 
  27.         "rsh ~a xterm -display ~a -g 80x10-5+~a -e 'feel -do \"~a\"' & \n"
  28.         host local-display x-vert exp))
  29.     
  30.   (defun run-remote (exp host)
  31.     (let ((str (run-remote-string exp host)))
  32.       (setq x-vert (+ x-vert 120))
  33.       (system str)
  34.       str))
  35.  
  36.   (deflocal my-listener (make-listener))
  37.  
  38.   (deflocal my-listener-id (listener-id my-listener))
  39.  
  40.   (deflocal hosts '(brad janet))
  41.  
  42.   (deflocal host-table (make-table eq))
  43.  
  44.   (defun host-boot (host)
  45.     (run-remote 
  46.       `(progn 
  47.      (load-module net-p-c) 
  48.      (start-module net-p-c run-client ',my-listener-id ',host))
  49.       host)
  50.     host)
  51.  
  52.   (defun prepare-hosts () 
  53.     (format t "Booting hosts...\n")
  54.     (boot-hosts hosts)
  55.     (format t "Connecting to hosts...\n")
  56.     (contact-hosts hosts)
  57.     (format t "Done.\n"))
  58.  
  59.   (defun boot-hosts (hosts)
  60.     (if (null hosts) nil
  61.       (progn
  62.     (host-boot (car hosts))
  63.     (boot-hosts (cdr hosts)))))
  64.  
  65.   (defun contact-hosts (hosts)
  66.     (if (null hosts) nil
  67.       (let* ((s (listen my-listener))
  68.          (h (socket-read s)))
  69.     ((setter table-ref) host-table h s)
  70.     (contact-hosts (cdr hosts)))))
  71.  
  72.   (defun prepare-hosts-aux (hl)
  73.     (if (null hl) nil
  74.       (progn
  75.     ((setter table-ref) host-table (car hl) (host-connect (car hl)))
  76.     (prepare-hosts-aux (cdr hl)))))
  77.  
  78.   (defun write-to-host (host exp)
  79.     (socket-write (table-ref host-table host) exp))
  80.  
  81.   (defun read-from-host (host)
  82.     (socket-read (table-ref host-table host)))
  83.  
  84.   (defun remote-thing(r1 r2 host thing)
  85.     (write-to-host host thing)
  86.     (write-to-host host r1)
  87.     (write-to-host host r2)
  88.     (read-from-host host))
  89.  
  90.   (defun remote-plus (r1 r2 host) (remote-thing r1 r2 host 'plus))
  91.  
  92.   (defun remote-minus (r1 r2 host) (remote-thing r1 r2 host 'minus))
  93.  
  94.   (defun remote-times (r1 r2 host) (remote-thing r1 r2 host 'times))
  95.  
  96.   (defun remote-close (host) (write-to-host host 'stop))
  97.  
  98.   (defun remote-close-all () (remote-close-all-aux hosts))
  99.  
  100.   (defun remote-close-all-aux (hosts)
  101.     (if (null hosts) (format t "All hosts closed\n")
  102.       (progn
  103.     (remote-close (car hosts))
  104.     (remote-close-all-aux (cdr hosts)))))
  105.  
  106.   (setq r1 '(((x . 2) . 1)))
  107.  
  108.   (setq r2 '(((x . 1) . 1) . 1))
  109.  
  110. )
  111.  
  112.